home *** CD-ROM | disk | FTP | other *** search
Text File | 1989-07-29 | 58.8 KB | 2,342 lines
unit Edit; {Editing routines used by the Image program} interface uses QuickDraw, OSIntf, PrintTraps, PickerIntf, ToolIntf, globals, Utilities, Graphics, Camera; procedure FlipOrRotate (DoWhat: FlipRotateType); procedure DoCopy; procedure DoCut; procedure DoPaste; procedure DoClear; procedure ScaleSelection; procedure RotateAndScale; procedure DoMouseDownInPasteControl (loc: point); procedure ShowPasteControl; procedure DrawPasteControl; procedure ShowClipboard; procedure DoObject (obj: ObjectType; event: EventRecord); procedure DoAirBrush (event: EventRecord); procedure DoBrush (event: EventRecord); procedure DoText (loc: point); procedure SetAirbrushSize; procedure SetBrushSize; procedure EditColor; procedure UpdateEditMenu; procedure ConvertClipboard; procedure DeZoom; procedure Zoom (event: EventRecord); procedure Scroll (event: EventRecord); procedure AreaFill (event: EventRecord); procedure EditThresholdColor; procedure EditExtraColors (entry: integer); procedure ZoomImageWindow (var trect: rect); procedure DoGrow (WhichWindow: WindowPtr; event: EventRecord); procedure DrawCharacter (ch: char); procedure GetPictFromScrap; function RgnNotTooBig (Rgn1, Rgn2: RgnHandle): boolean; procedure SetupOperation (item: integer); implementation procedure PivotSelection (var SelectionRect: rect; WindowRect: rect); var OldWidth, NewWidth, OldHeight, NewHeight, hCenter, vCenter, NewLeft, NewTop: integer; begin with SelectionRect do begin OldWidth := right - left; OldHeight := bottom - top; hCenter := left + OldWidth div 2; vCenter := top + OldHeight div 2; end; NewWidth := OldHeight; NewHeight := OldWidth; NewLeft := hCenter - NewWidth div 2; NewTop := vCenter - NewHeight div 2; with WindowRect do begin if (NewLeft + NewWidth) > right then NewLeft := right - NewWidth; if (NewTop + NewHeight) > bottom then NewTop := bottom - NewHeight; if NewLeft < 0 then NewLeft := 0; if NewTop < 0 then NewTop := 0; end; with SelectionRect do begin left := NewLeft; top := NewTop; right := NewLeft + NewWidth; bottom := NewTop + NewHeight; end; end; procedure FlipLine (var LineBuf: LineType; width: integer); var TempLine: LineType; i, WidthLessOne: integer; begin TempLine := LineBuf; WidthLessOne := width - 1; for i := 0 to width - 1 do LineBuf[i] := TempLine[WidthLessOne - i]; end; procedure ScreenToOffscreenRect (var r: rect); var p1, p2: point; begin with r do begin p1.h := left; p1.v := top; p2.h := right; p2.v := bottom; ScreenToOffscreen(p1); ScreenToOffscreen(p2); Pt2Rect(p1, p2, r); end; end; procedure FlipOrRotate; {(DoWhat: FlipRotateType)} var SaveInfo: InfoPtr; width, height, hDst, vSrc, vDst, hSrc, i, inc: integer; LineBuf: LineType; srect, drect, MaskRect: rect; PixelCount: LongInt; AutoSelectAll: boolean; begin if NotRectangular or NotInBounds or (UndoBuf = nil) then exit(FlipOrRotate); if Info^.PicSize > ClipBufSize then begin beep; exit(FlipOrRotate) end; StopDigitizing; AutoSelectAll := not Info^.RoiShowing; if AutoSelectAll then SelectAll(true); ShowWatch; if (DoWhat = RotateLeft) or (DoWhat = RotateRight) then WhatToUndo := UndoRotate else WhatToUndo := UndoFlip; SetupUndoFromClip; SetupUndo; UndoInfoRec := info^; UndoInfo := @UndoInfoRec; with UndoInfo^ do begin PicBaseAddr := UndoBuf; BytesPerRow := PixelsPerLine; end; SaveInfo := Info; srect := info^.osroirect; PixelCount := 0; case DoWhat of RotateLeft, RotateRight: with srect do begin if OptionKeyDown then DoOperation(EraseOp); drect := srect; with info^ do begin PivotSelection(drect, PicRect); MaskRect := drect; OffscreenToScreenRect(MaskRect); roiRect := MaskRect; osroiRect := drect; RectRgn(osRoiRgn, osRoiRect); end; width := right - left; if DoWhat = RotateLeft then begin hDst := drect.left; inc := 1 end else begin hDst := drect.right - 1; inc := -1 end; for vSrc := top to bottom - 1 do begin Info := UndoInfo; GetLine(left, vSrc, width, LineBuf); if DoWhat = RotateLeft then FlipLine(LineBuf, width); Info := SaveInfo; PutColumn(hDst, drect.top, width, LineBuf); hDst := hDst + inc; PixelCount := PixelCount + width; if PixelCount > 10000 then begin UpdateScreen(MaskRect); PixelCount := 0; end; end; end; FlipVertical: with srect do begin MaskRect := srect; OffscreenToScreenRect(MaskRect); width := right - left; vDst := bottom; for vSrc := top to bottom - 1 do begin Info := UndoInfo; GetLine(left, vSrc, width, LineBuf); Info := SaveInfo; vDst := vDst - 1; PutLine(left, vDst, width, LineBuf); end; end; FlipHorizontal: with srect do begin MaskRect := srect; OffscreenToScreenRect(MaskRect); width := right - left; for vSrc := top to bottom - 1 do begin Info := UndoInfo; GetLine(left, vSrc, width, LineBuf); FlipLine(LineBuf, width); Info := SaveInfo; PutLine(left, vSrc, width, LineBuf); PixelCount := PixelCount + width; if PixelCount > 10000 then begin UpdateScreen(MaskRect); PixelCount := 0; end; end; end; end; {case} Info := SaveInfo; with info^ do begin UpdatePicWindow; changes := true; end; SetupRoiRect; if AutoSelectAll then KillRoi; end; procedure CopyPicture; var tPort: GrafPtr; err: LongInt; line: integer; src, dst: ptr; begin TextOnClip := false; with info^ do begin if PicSize > ClipBufSize then begin beep; WhatsOnClip := Nothing; exit(CopyPicture) end; SetupUndo; if PictureType = camera then begin src := PicBaseAddr; dst := ClipBuf; for line := 1 to 480 do begin BlockMove(src, dst, 640); src := ptr(ord4(src) + 1024); dst := ptr(ord4(dst) + 640); end; end else BlockMove(PicBaseAddr, ClipBuf, PicSize); end; ClipboardConverted := false; with ClipBufInfo^ do begin PixelsPerLine := info^.PixelsPerLine; BytesPerRow := info^.PixelsPerLine; nLines := Info^.nLines; RoiRect := info^.roiRect; osroiRect := info^.osroiRect; roiType := Info^.roiType; PicRect := Info^.PicRect; GetPort(tPort); with osPort^.portPixMap^^ do begin RowBytes := BitOr(PixelsPerLine, $8000); bounds := PicRect; end; SetPort(GrafPtr(osPort)); with osPort^ do begin PortRect := PicRect; RectRgn(visRgn, PicRect); end; SetPort(tPort); if RoiType = RectRoi then WhatsOnClip := RectPic else WhatsOnClip := NonRectPic; if (info^.PictureType = camera) and (PasteMode = LiveSelection) then PasteMode := PasteFromCamera else PasteMode := NormalPaste; CopyRgn(info^.osroiRgn, osroiRgn); end; end; procedure CopyWindow; var tPort: GrafPtr; WindowSize: LongInt; WindowRect: rect; WhichWindow: WindowPtr; kind: integer; begin WhichWindow := FrontWindow; WindowRect := WhichWindow^.PortRect; kind := WindowPeek(WhichWindow)^.WindowKind; with WindowRect do WindowSize := LongInt(right) * bottom; if kind = LUTKind then WindowRect.bottom := 256; if kind = ProfilePlotKind then ConvertPlotToText; if kind = HistoKind then ConvertHistoToText; if (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) then begin Copying := true; DrawPlot; {Draw without grow box} Copying := false; end; if WindowSize > ClipBufSize then begin beep; WhatsOnClip := Nothing; exit(CopyWindow) end; ClipboardConverted := false; with ClipBufInfo^ do begin RoiType := RectRoi; RoiRect := WindowRect; osRoiRect := WindowRect; RectRgn(osroiRgn, osroiRect); PicRect := WindowRect; PixelsPerLine := WindowRect.right; BytesPerRow := PixelsPerLine; nLines := WindowRect.bottom; with osPort^.portPixMap^^ do begin RowBytes := BitOr(WindowRect.right, $8000); bounds := WindowRect; end; GetPort(tPort); with osPort^ do begin PortRect := PicRect; RectRgn(visRgn, PicRect); fgColor := BlackC; bkColor := WhiteC; end; WhatsOnClip := RectPic; PasteMode := NormalPaste; SetPort(GrafPtr(osPort)); hlock(handle(ClipBufInfo^.osPort^.portPixMap)); CopyBits(WhichWindow^.PortBits, BitMapHandle(ClipBufInfo^.osPort^.portPixMap)^^, WindowRect, WindowRect, SrcCopy, nil); hunlock(handle(ClipBufInfo^.osPort^.portPixMap)); SetPort(tPort); end; {with} end; procedure DoCopy; var err: OSErr; begin if ScrapNotCleared then begin ScrapNotCleared := false; err := ZeroScrap; OldScrapCount := GetScrapCount; end; case WhatToCopy of CopyColor: begin ClipColorIndex := CurrentColorIndex; WhatsOnClip := AColor; TextOnClip := false; end; CopySelection: CopyPicture; CopyHistogram, CopyPlot, CopyCLUT, CopyGrayMap: CopyWindow; CopyAreas, CopyLengths, CopyPoints: begin CopyResultsToBuffer; TextOnClip := true end; otherwise beep; end; end; procedure DoCut; begin DoCopy; if info^.RoiShowing then begin CurrentOp := EraseOp; OpPending := true end; end; procedure PasteColor; begin with info^ do if (CurrentTool = PickerTool) and (LUTMode = ColorPalette) then begin RedX[CurrentColorIndex] := RedX[ClipColorIndex]; GreenX[CurrentColorIndex] := GreenX[ClipColorIndex]; BlueX[CurrentColorIndex] := BlueX[ClipColorIndex]; UpdateColors; end else beep; end; procedure CenterRect (inRect, outRect: rect; var ResultRect: rect); var width, height, hcenter, vcenter: integer; begin with inRect do begin width := right - left; height := bottom - top; end; with outRect do begin hcenter := left + (right - left) div 2; vcenter := top + (bottom - top) div 2; end; with ResultRect do begin left := hcenter - width div 2; top := vcenter - height div 2; right := left + width; bottom := top + height; end; end; procedure PastePicture; var loc: point; width, height, osroiHeight, SrcHeight, PicHeight, dh, dv: integer; begin if info = NoInfo then begin PutMessage('To be able to paste you must have a document window open.', '', ''); exit(PastePicture) end; if PasteTransferMode <> SrcCopy then begin PasteTransferMode := SrcCopy; if PasteControl <> nil then DrawPasteControl end; with info^ do begin WhatToUndo := UndoPaste; SetupUndo; if RoiShowing then with RoiRect do {Pasting back into selection of same size?} if ((right - left) = (ClipBufInfo^.RoiRect.right - ClipBufInfo^.RoiRect.left)) and ((bottom - top) = (ClipBufInfo^.RoiRect.bottom - ClipBufInfo^.RoiRect.top)) and (ClipBufInfo^.RoiType = RoiType) then begin OpPending := true; CurrentOp := PasteOp; exit(PastePicture) end; with ClipBufInfo^.osroiRect do {Pasting into same size window?} if (PicRect.right = right - left) and (PicRect.bottom = (bottom - top)) and (ClipBufInfo^.RoiType = RectRoi) then begin SelectAll(true); OpPending := true; CurrentOp := PasteOp; exit(PastePicture) end; if RoiShowing or (roiType <> NoRoi) then KillRoi; CenterRect(ClipBufInfo^.osroiRect, SrcRect, osroiRect); with osroiRect do begin osroiHeight := bottom - top; with srcRect do srcHeight := bottom - top; with PicRect do PicHeight := bottom - top; if (osroiHeight > SrcHeight) and (osroiHeight < PicHeight) and (magnification = 1.0) then begin top := 0; bottom := osroiHeight; end; end; roiRect := osroiRect; OffscreenToScreenRect(roiRect); roiType := ClipBufInfo^.roiType; CopyRgn(ClipBufInfo^.osRoiRgn, osRoiRgn); dh := osRoiRect.left - osRoiRgn^^.rgnbbox.left; dv := osRoiRect.top - osRoiRgn^^.rgnbbox.top; OffsetRgn(osroiRgn, dh, dv); RoiShowing := true; OpPending := true; CurrentOp := PasteOp; if PasteMode = PasteFromCamera then ResetQuickCapture; end;{with} end; procedure GetPictFromScrap; {Converts system scrape to local scrape.} var phandle: handle; offset, length, size: LongInt; pframe: rect; width, height: integer; tPort: GrafPtr; ScrapInfo: PScrapStuff; begin ScrapInfo := InfoScrap; if ScrapInfo^.ScrapSize <= 0 then exit(GetPictFromScrap); phandle := NewHandle(0); length := GetScrap(phandle, 'PICT', offset); if length >= 0 then begin ShowWatch; pframe := PicHandle(phandle)^^.PicFrame; with pframe do begin width := right - left; height := bottom - top; size := LongInt(width) * height; if size > ClipBufSize then begin PutMessage('Sorry, but this picture is too large to paste.', '', ''); DisposHandle(phandle); exit(GetPictFromScrap) end; end; with ClipBufInfo^ do begin PixelsPerLine := width; nlines := height; SetRect(PicRect, 0, 0, width, height); osroiRect := PicRect; RectRgn(osroiRgn, osRoiRect); RoiType := Rectroi; GetPort(tPort); SetPort(GrafPtr(osPort)); BytesPerRow := PixelsPerLine; with osPort^.portPixMap^^ do begin RowBytes := BitOr(PixelsPerLine, $8000); bounds := PicRect; end; with CGrafPort(osPort^) do begin PortRect := PicRect; RectRgn(visRgn, PicRect); end; osPort^.fgColor := WhiteC; osPort^.bkColor := BlackC; PaintRect(PicRect); DrawPicture(PicHandle(phandle), PicRect); DisposHandle(phandle); SetPort(tPort); end; WhatsOnClip := ImportedPic; PasteMode := NormalPaste end; DisposHandle(phandle); end; procedure DoPaste; var NewScrapCount: integer; begin NewScrapCount := GetScrapCount; if NewScrapCount <> OldScrapCount then begin WhatsOnClip := Nothing; OldScrapCount := NewScrapCount; end; case WhatsOnClip of AColor: PasteColor; RectPic, NonRectPic, ImportedPic: PastePicture; Nothing: begin GetPictFromScrap; if WhatsOnClip = ImportedPic then PastePicture else beep; end; end; end; procedure EditExtraColors; {(entry: integer)} var where: point; inRGBColor, OutRGBColor: RGBColor; begin if (entry <> WhiteC) and (entry <> BlackC) then begin inRGBColor := ExtraColors[entry]; outRGBColor := inRGBColor; where.h := 0; where.v := 0; InitCursor; if GetColor(where, 'Pick a color, any color...', inRGBColor, outRGBColor) then with info^ do begin ExtraColors[entry] := OutRGBColor; changes := true; LoadLUT(cTable); end end else PutMessage('Sorry, but you can not edit white or black.', '', ''); end; procedure DoClear; begin if not NoSelection then begin WhatToUndo := UndoClear; SetupUndo; CurrentOp := EraseOp; OpPending := true end; end; procedure ScaleSelection; var percent, i, j, NewWidth, NewHeight: integer; scale: extended; begin if NoSelection or NotRectangular or NotInBounds then exit(ScaleSelection); if OpPending then begin OpPending := false; DoOperation(CurrentOp); end; DoCopy; percent := GetInt('Precent Reduction(10-1000):', 50); if (percent >= 10) and (percent <= 1000) then begin scale := percent / 100.0; DoOperation(EraseOp); UpdateScreen(info^.roiRect); info^.RoiShowing := true; PasteTransferMode := SrcCopy; if PasteControl <> nil then DrawPasteControl; DoPaste; with info^.osroiRect do begin NewWidth := round((right - left) * scale); NewHeight := round((bottom - top) * scale); left := left + (right - left - NewWidth) div 2; top := top + (bottom - top - NewHeight) div 2; right := left + NewWidth; bottom := top + NewHeight; end; with info^ do begin RectRgn(osroiRgn, osroiRect); RoiRect := osroiRect; OffscreenToScreenRect(RoiRect); end; UndoFromClip := true; WhatsOnClip := nothing; WhatToUndo := UndoScale; end; end; procedure GetAngleAndScale (var angle, hscale, vscale: extended); const AngleID = 3; hScaleID = 4; vScaleID = 5; var mylog: DialogPtr; item, i: integer; begin InitCursor; mylog := GetNewDialog(50, nil, pointer(-1)); angle := 45.0; hscale := 1.0; vscale := 1.0; SetDReal(MyLog, AngleID, angle, 1); SelIText(MyLog, AngleID, 0, 32767); SetDReal(MyLog, hScaleID, hscale, 1); SetDReal(MyLog, vScaleID, vscale, 1); OutlineButton(MyLog, ok, 16); repeat ModalDialog(nil, item); if item = AngleID then begin angle := GetDReal(MyLog, AngleID); if angle > 180.0 then angle := 180.0; if angle < -180.0 then angle := -180.0; end; if item = hScaleID then begin hscale := GetDReal(MyLog, hScaleID); if hscale > 10.0 then hscale := 100.0; if hscale < 0.1 then hscale := 0.1; end; if item = vScaleID then begin vscale := GetDReal(MyLog, vScaleID); if vscale > 10.0 then vscale := 10.0; if vscale < 0.1 then vscale := 0.1; end; until (item = ok) or (item = cancel); DisposDialog(mylog); if item = cancel then hscale := 0; end; procedure RotateAndScale; const pi = 3.14159; type radians = real; EraseType = (Erase, DontErase); var angle, CosAngle, SinAngle, htemp, vtemp, h, v, hscale, vscale: extended; hloc, vloc, value, width, height, hstart, vstart, hend, vend: integer; hfraction, vfraction, UpperAverage, LowerAverage: extended; LowerLeft, LowerRight, UpperLeft, UpperRight, hCenter, vCenter: integer; hRel, vRel, hbase, vbase, OldWidth, OldHeight: integer; SaveInfo: InfoPtr; AutoSelectAll, UseNearestNeighbor, DoScaling: boolean; MaskRect: rect; begin if NotRectangular or NotInBounds then exit(RotateAndScale); if Info^.PicSize > ClipBufSize then begin beep; exit(RotateAndScale) end; StopDigitizing; with info^ do UseNearestNeighbor := OptionKeyDown or (LutMode = custom) or (LutMode = AppleDefault); GetAngleAndScale(angle, hscale, vscale); if hscale = 0.0 then exit(RotateAndScale); UpdatePicWindow; DrawTools; AutoSelectAll := not Info^.RoiShowing; if AutoSelectAll then SelectAll(true); ShowWatch; WhatToUndo := UndoRotate; SetupUndoFromClip; SetupUndo; UndoInfoRec := info^; UndoInfo := @UndoInfoRec; with UndoInfo^ do begin PicBaseAddr := UndoBuf; BytesPerRow := PixelsPerLine; end; SaveInfo := Info; angle := -((angle + 270.0) / 360.0) * 2.0 * pi; CosAngle := cos(angle); SinAngle := sin(angle); with info^.osroiRect, info^ do begin width := right - left; height := bottom - top; hCenter := left + (width div 2); vCenter := top + (height div 2); if hscale <> 1.0 then begin OldWidth := width; width := round(width * hscale); if width > PicRect.right then width := PicRect.right; left := left - (width - OldWidth) div 2; if left < 0 then left := 0; if (left + width) > PicRect.right then width := PicRect.right - left; right := left + width; roiRect := osRoiRect; OffscreenToScreenRect(roiRect); RectRgn(osRoiRgn, osRoiRect); end; if vscale <> 1.0 then begin OldHeight := height; height := round(height * vscale); if height > PicRect.bottom then height := PicRect.bottom; top := top - (height - OldHeight) div 2; if top < 0 then top := 0; if (top + height) > PicRect.bottom then height := PicRect.bottom - top; bottom := top + height; roiRect := osRoiRect; OffscreenToScreenRect(roiRect); RectRgn(osRoiRgn, osRoiRect); end; hStart := left; vStart := top; hend := hstart + width - 1; vend := vstart + height - 1; end; DoScaling := (hscale <> 0.0) or (vscale <> 0.0); for vloc := vStart to vEnd do begin for hloc := hStart to hEnd do begin hrel := hloc - hCenter; vrel := vloc - vCenter; htemp := hrel * SinAngle + vrel * CosAngle; vtemp := vrel * SinAngle - hrel * CosAngle; if DoScaling then begin htemp := htemp / hscale; vtemp := vtemp / vscale; end; h := htemp + hCenter; v := vtemp + vCenter; info := UndoInfo; if UseNearestNeighbor then value := MyGetPixel(round(h), round(v)) else begin {Use bilinear interpolation} hbase := trunc(h); vbase := trunc(v); hFraction := h - hbase; vFraction := v - vbase; LowerLeft := MyGetPixel(hbase, vbase); LowerRight := MyGetPixel(hbase + 1, vbase); UpperRight := MyGetPixel(hbase + 1, vbase + 1); UpperLeft := MyGetPixel(hbase, vbase + 1); UpperAverage := UpperLeft + hfraction * (UpperRight - UpperLeft); LowerAverage := LowerLeft + hfraction * (LowerRight - LowerLeft); value := round(LowerAverage + vfraction * (UpperAverage - LowerAverage)); end; Info := SaveInfo; PutPixel(hloc, vloc, value); end; SetRect(MaskRect, hstart, vloc, hend, vloc + 1); OffscreenToScreenRect(MaskRect); UpdateScreen(MaskRect); if CommandPeriod then begin UpdateScreen(info^.roiRect); beep; SetupRoiRect; if AutoSelectAll then KillRoi; exit(RotateAndScale) end; end; with info^ do changes := true; SetupRoiRect; if AutoSelectAll then KillRoi; end; procedure DoMath; const PixelsPerUpdate = 15000; var nrows, ncols, hSrcStart, vSrcStart, hDstStart, vDstStart: integer; SaveInfo: InfoPtr; h, v, vDst, PixelCount, offset: integer; Src, Dst: LineType; tmp, range, min, max: LongInt; x, xmax, xmin, xrange, xscale: extended; begin ShowWatch; OpPending := false; WhatToUndo := UndoPaste; KillRoi; with info^.osroiRect do begin ncols := right - left; nrows := bottom - top; hDstStart := left; vDstStart := top; end; with ClipBufInfo^.osroiRect do begin hSrcStart := left; vSrcStart := top; end; if hDstStart < 0 then begin offset := -hDstStart; hDstStart := 0; hSrcStart := hSrcStart + offset; ncols := ncols - offset; end; if vDstStart < 0 then begin offset := -vDstStart; vDstStart := 0; vSrcStart := vSrcStart + offset; nrows := nrows - offset; end; with info^.PicRect do begin if hDstStart + ncols > right then ncols := right - hDstStart; if vDstStart + nrows > bottom then nrows := bottom - vDstStart; end; SaveInfo := info; vDst := vDstStart; min := 999999; max := -999999; xmin := 999999.0; xmax := -999999.0; {First pass to find result range} for v := vSrcStart to vSrcStart + nRows - 1 do begin Info := ClipBufInfo; GetLine(hSrcStart, v, nCols, Src); Info := SaveInfo; GetLine(hDstStart, vDst, nCols, Dst); case CurrentOp of AddOp: begin for h := 0 to nCols - 1 do begin tmp := Src[h] + Dst[h]; if tmp > max then max := tmp; if tmp < Min then min := tmp; end; end; SubtractOp: begin for h := 0 to nCols - 1 do begin tmp := Dst[h] - Src[h]; if tmp > max then max := tmp; if tmp < Min then min := tmp; end; end; MultiplyOp: begin for h := 0 to nCols - 1 do begin tmp := LongInt(Dst[h]) * Src[h]; if tmp > max then max := tmp; if tmp < min then min := tmp; end; end; DivideOp: begin for h := 0 to nCols - 1 do begin tmp := Src[h]; if tmp = 0 then tmp := 1; x := Dst[h] / tmp; if x > xmax then begin xmax := x; end; if x < xmin then xmin := x; end; end; end; vDst := vDst + 1; end; vDst := vDstStart; if CurrentOp = DivideOp then begin xrange := xmax - xmin; if xrange <> 0.0 then xscale := 256.0 / xrange else xscale := 1; end else range := max - min; PixelCount := 0; {Second pass to do arithmetic and scaling} for v := vSrcStart to vSrcStart + nRows - 1 do begin Info := ClipBufInfo; GetLine(hSrcStart, v, nCols, Src); Info := SaveInfo; GetLine(hDstStart, vDst, nCols, Dst); case CurrentOp of AddOp: begin for h := 0 to nCols - 1 do begin tmp := Dst[h] + Src[h] - min; if range <> 0 then tmp := tmp * 256 div range else tmp := BackgroundColor; if tmp > 255 then dst[h] := 255 else dst[h] := tmp; end; end; SubtractOp: begin for h := 0 to nCols - 1 do begin tmp := Dst[h] - Src[h] - min; if range <> 0 then tmp := tmp * 256 div range else tmp := BackgroundColor; if tmp > 255 then dst[h] := 255 else dst[h] := tmp; end; end; MultiplyOp: begin for h := 0 to nCols - 1 do begin tmp := LongInt(Dst[h]) * Src[h] - min; if range <> 0 then tmp := tmp * 256 div range else tmp := BackgroundColor; if tmp > 255 then dst[h] := 255 else dst[h] := tmp; end; end; DivideOp: begin for h := 0 to nCols - 1 do begin tmp := Src[h]; if tmp = 0 then tmp := 1; x := Dst[h] / tmp - xmin; if xrange <> 0.0 then tmp := trunc(x * xscale) else tmp := BackgroundColor; if tmp > 255 then tmp := 255; if tmp < 0 then tmp := 0; dst[h] := tmp; end; end end; PutLine(hDstStart, vDst, nCols, Dst); vDst := vDst + 1; PixelCount := PixelCount + ncols; if PixelCount > PixelsPerUpdate then begin UpdateScreen(info^.roiRect); if CommandPeriod then begin UpdateScreen(info^.roiRect); beep; exit(DoMath) end; PixelCount := 0; end; end; UpdateScreen(info^.RoiRect); end; procedure DoMouseDownInPasteControl; {(loc:point)} var tPort, tPort2: GrafPtr; nItem, i: integer; BlendColor: rgbColor; procedure InvertItem; begin with pcItem[nitem] do if iType = pcButton then InvertRoundRect(r, 6, 6) else InvertOval(r); end; begin GetPort(tPort); SetPort(PasteControl); GlobalToLocal(loc); nItem := 0; for i := 1 to npcItems do if PtInRect(loc, pcItem[i].r) then nitem := i; if nItem > 0 then begin InvertItem; while Button and (nitem > 0) do begin GetMouse(loc); if not PtInRect(loc, pcItem[nitem].r) then begin InvertItem; nItem := 0; end; end; end; repeat until not button; if nItem > 0 then with pcItem[nitem] do begin InvertItem; case nItem of 1: PasteTransferMode := SrcCopy; 2: PasteTransferMode := SrcOr; 3: PasteTransferMode := SrcXor; 4: begin GetPort(tPort2); with BlendColor do begin red := 32767; blue := 32767; green := 32767; end; SetPort(GrafPtr(info^.osPort)); OpColor(BlendColor); SetPort(tPort2); PasteTransferMode := blend; end; 5, 6, 7, 8: if OpPending and (CurrentOp = PasteOp) and (info^.RoiType = RectRoi) then begin case nitem of 5: CurrentOp := AddOp; 6: CurrentOp := SubtractOp; 7: CurrentOp := MultiplyOp; 8: CurrentOp := DivideOp; end; DoMath; end; end; end; SetPort(tPort); DrawPasteControl; end; procedure DrawPasteControl; const bWidth = 64; bHeight = 14; rbWidth = 12; rbInnerWidth = 5; rbhloc = 6; rbvloc = 6; vinc = 17; bhloc = 75; bvloc = 6; var tPort: GrafPtr; i, hloc, vloc, SetItem: integer; tType: pcItemType; tRect: rect; begin GetPort(tPort); SetPort(PasteControl); hloc := rbhloc; vloc := rbvloc; tType := pcRadioButton; with PcItem[1] do begin SetRect(r, hloc, vloc, hloc + rbWidth, vloc + rbWidth); itype := tType; str := 'Copy'; end; vloc := vloc + vinc; with pcItem[2] do begin SetRect(r, hloc, vloc, hloc + rbWidth, vloc + rbWidth); itype := tType; str := 'Or'; end; vloc := vloc + vinc; with pcItem[3] do begin SetRect(r, hloc, vloc, hloc + rbWidth, vloc + rbWidth); itype := tType; str := 'Xor'; end; vloc := vloc + vinc; with pcItem[4] do begin SetRect(r, hloc, vloc, hloc + rbWidth, vloc + rbWidth); itype := tType; str := 'Blend'; end; hloc := bhloc; vloc := bvloc; tType := pcButton; with pcItem[5] do begin SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight); itype := tType; str := 'Add'; end; vloc := vloc + vinc; with pcItem[6] do begin SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight); itype := tType; str := 'Subtract'; end; vloc := vloc + vinc; with pcItem[7] do begin SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight); itype := tType; str := 'Multiply'; end; vloc := vloc + vinc; with pcItem[8] do begin SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight); itype := tType; str := 'Divide'; end; TextFont(SystemFont); TextSize(12); case PasteTransferMode of SrcCopy: SetItem := 1; SrcOr: SetItem := 2; SrcXor: SetItem := 3; Blend: SetItem := 4; end; for i := 1 to npcItems do with pcItem[i] do if iType = pcRadioButton then begin EraseOval(r); FrameOval(r); if i = SetItem then begin tRect := r; InsetRect(tRect, 3, 3); PaintOval(tRect); end; MoveTo(r.left + rbWidth + 4, r.top + rbWidth - 2); DrawString(str); end else begin FrameRoundRect(r, 6, 6); with r do MoveTo(left + ((right - left) - StringWidth(str)) div 2, bottom - 3); DrawString(str); end; SetPort(tPort); end; procedure ShowPasteControl; const pcwidth = 148; pcheight = 75; var tPort: GrafPtr; blend: RGBColor; trect: rect; wp: ^WindowPtr; begin SetRect(trect, ScreenWidth - pcwidth - 10, ScreenHeight - pcheight - 10, ScreenWidth - 10, ScreenHeight - 10); PasteControl := NewWindow(nil, trect, 'Paste Control', true, rDocProc, nil, true, 0); WindowPeek(PasteControl)^.WindowKind := PasteControlKind; wp := pointer(GhostWindow); wp^ := PasteControl; SetMenuItem(GetMHandle(WindowsMenu), 9, true); end; procedure ShowClipboard; var width, height, hstart, vstart, i, NewScrapCount: integer; begin NewScrapCount := GetScrapCount; if NewScrapCount <> OldScrapCount then begin WhatsOnClip := Nothing; OldScrapCount := NewScrapCount; end; if WhatsOnClip = Nothing then GetPictFromScrap; if (WhatsOnClip = RectPic) or (WhatsOnClip = NonRectPic) or (WhatsOnClip = ImportedPic) then with ClipBufinfo^.osroiRect do begin width := right - left; if odd(width) then width := Width + 1; height := bottom - top; if NewPicWindow('Clipboard', width, height) then begin PastePicture; KillRoi; SetupUndo; WhatToUndo := NothingToUndo; info^.changes := false; end; end; end; function RgnNotTooBig; {(Rgn1, Rgn2: RgnHandle): boolean} begin RgnNotTooBig := GetHandleSize(handle(Rgn1)) + GetHandleSize(handle(Rgn2)) < 30000 end; procedure DoSelection (obj: ObjectType; start, finish: point); var tRect: rect; temp: integer; TempRgn: RgnHandle; begin WhatToUndo := NothingToUndo; Info^.RoiShowing := false; if (start.h = finish.h) or (start.v = finish.v) then exit(DoSelection); if start.h > finish.h then begin temp := start.h; start.h := finish.h; finish.h := temp; end; if start.v > finish.v then begin temp := start.v; start.v := finish.v; finish.v := temp; end; Pt2Rect(start, finish, tRect); ScreenToOffscreenRect(tRect); with info^ do begin RoiShowing := true; if SelectionMode <> NewSelection then TempRgn := NewRgn; PenNormal; OpenRgn; case obj of SelectionOval: begin FrameOval(tRect); roiType := OvalRoi; end; RoundedRect: begin FrameRoundRect(tRect, OvalSize, OvalSize); roiType := RoundRectRoi; end; SelectionRect: begin FrameRect(tRect); roiType := RectRoi; end; end; if SelectionMode = NewSelection then CloseRgn(osroiRgn) else begin CloseRgn(TempRgn); if RgnNotTooBig(osroiRgn, TempRgn) then begin if SelectionMode = AddSelection then UnionRgn(osroiRgn, TempRgn, osroiRgn) else begin DiffRgn(osroiRgn, TempRgn, osroiRgn); UpdatePicWindow; end; end; DisposeRgn(TempRgn); if GetHandleSize(handle(osroiRgn)) = 10 then roiType := RectRoi else roiType := RgnRoi; end; osroiRect := osroiRgn^^.rgnBBox; roiRect := osroiRect; OffscreenToScreenRect(roiRect); end;{with} measuring := false; end; procedure FindLength (start, finish: point); var length, h1, h2, v1, v2: extended; begin DrawObject(LineObj, start, finish); ScreenToOffscreen(start); ScreenToOffscreen(finish); h1 := start.h; h2 := finish.h; v1 := start.v; v2 := finish.v; if nLengths < MaxLengths then begin nLengths := nLengths + 1; UnsavedLengths := UnsavedLengths + 1 end else beep; length := sqrt(sqr(h2 - h1) + sqr(v2 - v1)); PixelLength := length; with info^ do if scale <> 0.0 then length := length / scale; lengths[nLengths] := length; TotalLength := TotalLength + length; ShowResults; measuring := true; end; procedure DoObject; {(obj: ObjectType; event: EventRecord)} var Start, Finish, ScreenStart, ScreenFinish, osStart, osFinish: point; r: rect; tPort: GrafPtr; ff, DeltaX, DeltaY, switch, imag: integer; Constrain: boolean; begin if (obj = LengthObj) or (obj = PlotLine) or (obj = LineObj) then ValuesMode := LengthValues else ValuesMode := WidthValues; DrawLabels; start := event.where; osStart := start; ScreenToOffscreen(osStart); finish := start; PenNormal; PenMode(PatXor); with info^ do begin imag := trunc(magnification + 0.5); ff := imag div 2; if (obj = SelectionRect) or (obj = SelectionOval) or (obj = RoundedRect) then PenSize(imag, imag) else PenSize(imag * LineWidth, imag * LineWidth); end; while button do begin GetMouse(finish); with finish, Info^ do begin if h > wrect.right then h := wrect.right; if v > wrect.bottom then v := wrect.bottom; if h < 0 then h := 0; if v < 0 then v := 0; end; if ShiftKeyDown then begin DeltaX := finish.h - start.h; DeltaY := finish.v - start.v; if (obj = lineObj) or (obj = PlotLine) or (obj = LengthObj) then begin if abs(DeltaX) > abs(DeltaY) then finish.v := start.v else finish.h := start.h end else begin if ((DeltaX > 0) and (DeltaY < 0)) or ((DeltaX < 0) and (DeltaY > 0)) then switch := -1 else switch := 1; if abs(DeltaX) > abs(DeltaY) then finish.h := start.h + switch * DeltaY else finish.v := start.v + switch * DeltaX; end; end; osFinish := finish; ScreenToOffscreen(osfinish); case obj of LineObj, PlotLine, LengthObj: begin MoveTo(start.h - ff, start.v - ff); LineTo(finish.h - ff, finish.v - ff); Show3RealValues(abs(osfinish.h - osstart.h), abs(osfinish.v - osstart.v), sqrt(sqr(LongInt(osfinish.h - osstart.h)) + sqr(LongInt(osfinish.v - osstart.v)))); MoveTo(start.h - ff, start.v - ff); LineTo(finish.h - ff, finish.v - ff); end; Rectangle, SelectionRect: begin if obj = SelectionRect then begin PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); end; Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameRect(r); Show2Values(osfinish.h - osstart.h, osfinish.v - osstart.v); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameRect(r); end; RoundedRect: begin PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameRoundRect(r, OvalSize, OvalSize); Show2Values(osfinish.h - osstart.h, osfinish.v - osstart.v); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameRoundRect(r, OvalSize, OvalSize); end; SelectionOval: begin PatIndex := (PatIndex + 1) mod 8; PenPat(pat[PatIndex]); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameOval(r); Show2Values(osfinish.h - osstart.h, osfinish.v - osstart.v); Pt2Rect(start, finish, r); OffsetRect(r, -ff, -ff); FrameOval(r); end; end; end; if obj = PlotLine then begin DoPlot(event, start, finish); if OptionKeyDown then obj := LineObj else exit(DoObject) end; case obj of SelectionRect, SelectionOval, RoundedRect: DoSelection(obj, start, finish); LengthObj: FindLength(start, finish); otherwise DrawObject(obj, start, finish); end; end; procedure RandowBrushPoint (var xoffset, yoffset: integer); begin repeat xoffset := (random mod AirBrushdiameter + random mod AirBrushdiameter) div 2 - AirBrushRadius; yoffset := (random mod AirBrushDiameter + random mod AirBrushDiameter) div 2 - AirBrushRadius; until xoffset * xoffset + yoffset * yoffset <= AirBrushRadius2; end; procedure DrawAirBrush (xcenter, ycenter: integer); var i, xoff, yoff: integer; begin for i := 1 to 5 * trunc(info^.magnification + 0.5) + 3 do begin RandowBrushPoint(xoff, yoff); PutPixel(xcenter + xoff, ycenter + yoff, ForegroundColor); end; end; procedure DoAirBrush; {(event: EventRecord)} {Reference: "Spaying and Smudging", Dick Pountain, Byte, November 1987} var h, xcenter, ycenter, off: integer; MaskRect: rect; pt: point; begin with info^ do begin changes := true; off := AirbrushRadius * trunc(magnification + 0.5); end; repeat GetMouse(pt); with MaskRect, pt do begin left := h - off; top := v - off; right := h + off; bottom := v + off; end; ScreenToOffscreen(pt); with pt do begin xcenter := h; ycenter := v end; DrawAirbrush(xcenter, ycenter); UpdateScreen(MaskRect); until not button; end; procedure DoBrush; {(event: EventRecord)} var r, ScreenRect: rect; tPort: GrafPtr; p1, p2, p2x, start: point; WhichWindow: WindowPtr; SaveLineWidth, SaveForegroundColor: integer; Constrained, MoreHorizontal, FirstTime: boolean; offset, IntegerMagnification, width: integer; begin SaveLineWidth := LineWidth; p1 := event.where; start := p1; if OptionKeyDown then begin case CurrentTool of Brush, Pencil: GetForegroundColor(event); Eraser: GetBackgroundColor(event); end; if (CurrentTool = Brush) or (CurrentTool = Eraser) then exit(DoBrush); end; case CurrentTool of Pencil: LineWidth := 1; Brush, Eraser: begin IntegerMagnification := trunc(info^.magnification); if IntegerMagnification < 1 then IntegerMagnification := 1; if CurrentTool = Brush then width := BrushWidth else width := 16; LineWidth := width div IntegerMagnification; if LineWidth < 1 then LineWidth := 1; end; end; with info^ do begin offset := round(LineWidth * magnification / 2.0); if magnification >= 2.0 then offset := offset - 1; end; if CurrentTool <> Pencil then with p1 do begin h := h - offset; v := v - offset end; Constrained := ShiftKeyDown; FirstTime := true; if CurrentTool = eraser then begin SaveForegroundColor := ForegroundColor; SetForegroundColor(BackgroundColor) end else SetForegroundColor(ForegroundColor); repeat GetMouse(p2); if CurrentTool <> Pencil then with p2 do begin h := h - offset; v := v - offset end; if FirstTime then if not EqualPt(p1, p2) then begin MoreHorizontal := abs(p2.h - p1.h) >= abs(p2.v - p1.v); FirstTime := false; end; if Constrained then if MoreHorizontal then p2.v := p1.v else p2.h := p1.h; if CurrentTool = brush then DrawObject(BrushObj, p1, p2) else DrawObject(LineObj, p1, p2); p1 := p2; until not button; if CurrentTool = Eraser then SetForegroundColor(SaveForegroundColor); LineWidth := SaveLineWidth; end; procedure DrawCharacter; {(ch: char)} var tPort: GrafPtr; p1, p2: point; width: integer; MaskRect: rect; ScreenLoc: point; str: str255; begin if (not IsInsertionPoint) or (Info = NoInfo) then begin beep; exit(DrawCharacter) end; if ch = return then with InsertionPoint do begin h := TextStart.h; v := v + CurrentSize; SetupUndo; TextStr := ''; TextStart := InsertionPoint; exit(DrawCharacter) end; GetPort(tPort); SetPort(GrafPtr(Info^.osPort)); TextFont(CurrentFontID); TextFace(CurrentStyle); TextSize(CurrentSize); if ch = BackSpace then with InsertionPoint do begin if length(TextStr) > 0 then begin delete(TextStr, length(TextStr), 1); DisplayText; end; SetPort(tPort); exit(DrawCharacter) end; str := ' '; {Needed for MPW} str[1] := ch; TextStr := Concat(TextStr, str); DisplayText; SetPort(tPort); end; procedure DoText; {(loc: point)} var str: str255; i: integer; begin ScreenToOffscreen(loc); with loc do begin InsertionPoint.h := h; InsertionPoint.v := v + 4; end; IsInsertionPoint := true; TextStart := InsertionPoint; TextStr := ''; if OptionKeyDown then begin if nAreas2 > 0 then begin str := ''; if AreaM in Measurements then with info^ do begin if scale <> 0.0 then RealToString(PixelCount[nAreas2] / sqr(scale), 1, 2, str) else NumToString(PixelCount[nAreas2], str); end else if MeanM in Measurements then RealToString(Mean[nAreas2], 1, 2, str); if str <> '' then begin if nAreas2 > 0 then nAreas2 := nAreas2 - 1; for i := 1 to length(str) do DrawCharacter(str[i]); end; end; end; end; procedure AreaFill; {(event: EventRecord)} var loc: point; MaskBits: BitMap; BitMapSize: LongInt; tPort: GrafPtr; trect: rect; begin ShowWatch; loc := event.where; ScreenToOffscreen(loc); with info^ do begin tRect := PicRect; with tRect do if right mod 8 <> 0 then right := (right div 16) * 16; with MaskBits do begin RowBytes := PixelsPerLine div 8 + 1; if odd(RowBytes) then RowBytes := RowBytes + 1; bounds := tRect; BitMapSize := LongInt(rowBytes) * nLines; baseAddr := NewPtr(BitMapSize); if baseAddr = nil then begin beep; exit(AreaFill) end; end; GetPort(tPort); SetPort(GrafPtr(osPort)); SeedCFill(BitMapHandle(osPort^.PortPixMap)^^, MaskBits, tRect, tRect, loc.h, loc.v, nil, 0); osPort^.fgColor := ForegroundColor; CopyBits(MaskBits, BitMapHandle(osPort^.PortPixMap)^^, tRect, tRect, SrcOr, nil); DisposPtr(MaskBits.baseAddr); end; SetPort(tPort); UpdatePicWindow; end; procedure SetAirbrushSize; var TempSize: integer; begin TempSize := GetInt('Airbrush diameter in pixels(1..99):', AirbrushDiameter); if TempSize = -MaxInt then exit(SetAirBrushSize); if (TempSize > 0) and (TempSize < 100) then begin AirbrushDiameter := TempSize; AirbrushRadius := AirbrushDiameter div 2; AirbrushRadius2 := AirbrushRadius * AirBrushRadius end else beep; end; procedure SetBrushSize; var TempSize: integer; begin TempSize := GetInt('Brush Size in pixels(1..99):', BrushWidth); if TempSize = -MaxInt then exit(SetBrushSize); if (TempSize > 0) and (TempSize < 100) then begin BrushWidth := TempSize; BrushHeight := BrushWidth end else beep; end; procedure EditColor; var where: point; inRGBColor, OutRGBColor: RGBColor; index: integer; begin with info^ do begin index := GetColorIndex; if index = NoColor then exit(EditColor); with inRGBColor do begin red := RedX[index]; green := GreenX[index]; blue := BlueX[index]; end; outRGBColor := inRGBColor; where.h := 0; where.v := 0; InitCursor; if GetColor(where, 'Pick a color, any color...', inRGBColor, outRGBColor) then begin with outRGBColor do begin RedX[index] := red; GreenX[index] := green; BlueX[index] := blue; end; info^.changes := true; end; UpdateColors; end; {with} end; procedure EditThresholdColor; var where: point; inRGBColor, OutRGBColor: RGBColor; begin inRGBColor := ThresholdColor; outRGBColor := inRGBColor; where.h := 0; where.v := 0; InitCursor; if GetColor(where, 'Pick a new color...', inRGBColor, outRGBColor) then ThresholdColor := outRGBColor; DrawThreshold; end; procedure FindWhatToCopy; var kind: integer; WhichWindow: WindowPtr; begin WhatToCopy := NothingToCopy; if CurrentTool = PickerTool then WhatToCopy := CopyColor else begin WhichWindow := FrontWindow; kind := WindowPeek(WhichWindow)^.WindowKind; if (kind = PicKind) and measuring then kind := ResultsKind; case kind of PicKind: with info^, info^.osroirect do if RoiShowing and (left >= 0) and (top >= 0) and (right <= PicRect.right) and (bottom <= PicRect.bottom) then WhatToCopy := CopySelection; HistoKind: WhatToCopy := CopyHistogram; ProfilePlotKind, CalibrationPlotKind: WhatToCopy := CopyPlot; LUTKind: if info <> NoInfo then WhatToCopy := CopyCLUT; GrayMapKind: if info <> NoInfo then WhatToCopy := CopyGrayMap; ResultsKind: if (CurrentTool = ruler) and (nLengths > 0) then WhatToCopy := CopyLengths else if (CurrentTool = PointingTool) and (nPoints > 0) then WhatToCopy := CopyPoints else if nAreas > 0 then WhatToCopy := CopyAreas; otherwise end; end; end; procedure UpdateEditMenu; var DimUndo, ShowItems: boolean; str: str255; kind, i: integer; WhichWindow: WindowPtr; begin WhichWindow := FrontWindow; kind := WindowPeek(WhichWindow)^.WindowKind; if kind < 0 then begin {DA is active, so activate Edit menu.} SetItem(EditMenuH, 1, 'Undo'); SetItem(EditMenuH, 3, 'Cut'); SetItem(EditMenuH, 4, 'Copy'); SetMenuItem(EditMenuH, 1, true); for i := 3 to 6 do SetMenuItem(EditMenuH, i, true); exit(UpdateEditMenu); end; DimUndo := WhatToUndo = NothingToUndo; SetMenuItem(EditMenuH, 1, not DimUndo); if DimUndo then SetItem(EditMenuH, 1, 'Undo'); case WhatToUndo of UndoEdit: str := 'Editing'; UndoFlip: str := 'Flip'; UndoRotate: str := 'Rotate'; UndoScale: str := 'Scaling'; UndoFilter: str := 'Filtering'; UndoPaste: str := 'Paste'; UndoMeasurement: str := 'Measurement'; UndoTransform: str := 'Transformation'; UndoClear: str := 'Clear'; UndoContrastEnhancement: str := 'Contrast Enhancement'; UndoEqualization: str := 'Equalization'; UndoZoom: str := 'Zoom'; UndoPlot: str := '3D Plot'; UndoOutline: str := 'Outline'; otherwise str := ''; end; SetItem(EditMenuH, 1, concat('Undo ', str)); FindWhatToCopy; if WhatToCopy = CopySelection then str := 'Cut Selection' else str := 'Cut'; SetItem(EditMenuH, 3, str); SetMenuItem(EditMenuH, 3, WhatToCopy = CopySelection); case WhatToCopy of NothingToCopy: str := ''; CopySelection: str := 'Selection'; CopyCLUT: str := 'Palette'; CopyGrayMap: str := 'Gray Map'; CopyPlot: str := 'Plot'; CopyHistogram: str := 'Histogram'; CopyAreas: str := 'Measurements'; CopyLengths: str := 'Lengths'; CopyPoints: str := 'Points'; CopyColor: str := 'Color'; end; SetItem(EditMenuH, 4, concat('Copy ', str)); SetMenuItem(EditMenuH, 4, WhatToCopy <> NothingToCopy); SetMenuItem(EditMenuH, 6, WhatToCopy = CopySelection); ShowItems := (WhatsOnClip <> nothing) or (OldScrapCount <> GetScrapCount); SetMenuItem(EditMenuH, 5, ShowItems); SetMenuItem(EditMenuH, 22, ShowItems); ShowItems := info <> NoInfo; for i := 8 to 10 do SetMenuItem(EditMenuH, i, ShowItems); for i := 13 to 14 do SetMenuItem(EditMenuH, i, ShowItems); for i := 16 to 20 do SetMenuItem(EditMenuH, i, ShowItems); end; procedure DeZoom; var Width, Height, divisor: integer; OldMagnification: extended; begin with Info^ do begin if not EqualRect(wrect, savewrect) then begin UnZoom; Exit(DeZoom) end; if magnification < 2.0 then begin beep; exit(DeZoom) end; OldMagnification := magnification; if magnification = 2.0 then begin magnification := 1.0; divisor := 4 end else if magnification = 3.0 then begin magnification := 2.0; divisor := 6 end else if magnification = 4.0 then begin magnification := 3.0; divisor := 8 end else begin magnification := magnification / 2.0; divisor := 4 end; end; with Info^.SrcRect, info^ do begin width := round((right - left) * OldMagnification / Magnification); height := round((bottom - top) * OldMagnification / Magnification); left := left - (width div divisor); if left < 0 then left := 0; if (left + width) > Info^.PicRect.right then left := Info^.PicRect.right - round(width); top := top - (height div divisor); if top < 0 then top := 0; if (top + height) > Info^.PicRect.bottom then top := Info^.picRect.bottom - round(height); right := left + width; bottom := top + height; if magnification = 1.0 then SrcRect := wrect; RoiShowing := false; UpdatePicWindow; DrawMyGrowIcon(wptr); end; ShowRoi; end; procedure ZoomImageWindow; {(var trect: rect)} var WindowLeft, WindowTop: integer; PicAspectRatio, TempMagnification: extended; begin with info^ do begin SrcRect := PicRect; with CGrafPort(wptr^).PortPixMap^^.bounds do begin WindowLeft := -left; WindowTop := -top; end; with PicRect do PicAspectRatio := right / bottom; with trect do begin if (WindowLeft + right) > (ScreenWidth - 5) then right := ScreenWidth - 5 - WindowLeft; bottom := round(right / PicAspectRatio); if (WindowTop + bottom) > (ScreenHeight - 5) then bottom := ScreenHeight - 5 - WindowTop; right := round(bottom * PicAspectRatio); magnification := right / PicRect.right; end; RoiRect := osroiRect; OffscreenToScreenRect(RoiRect); end; {with} end; procedure DoGrow; {(WhichWindow: WindowPtr; event: EventRecord)} var NewSize: LongInt; tPort: GrafPtr; trect, WinRect: rect; ZoomCenterH, ZoomCenterV, width, height, imag, kind: integer; begin kind := WindowPeek(WhichWindow)^.WindowKind; if (kind = PicKind) and (info^.PictureType = ScionType) then exit(DoGrow); NewSize := GrowWindow(WhichWindow, event.where, ScreenBits.bounds); if newSize = 0 then exit(DoGrow); if WindowPeek(WhichWindow)^.WindowKind = PicKind then with Info^ do begin InvalRect(wrect); with trect do begin top := 0; left := 0; right := LoWord(NewSize); bottom := HiWord(NewSize); if PictureType = camera then begin GetWindowRect(WhichWindow, WinRect); if WinRect.left + right + 4 > ScreenWidth then right := ScreenWidth - WinRect.left - 4; if WinRect.top + bottom + 4 > ScreenHeight then bottom := ScreenHeight - WinRect.top - 4; end; end; if ScaleToFitWindow then begin ZoomImageWindow(trect); wrect := trect; end else begin imag := trunc(magnification); if imag < 1 then imag := 1; if trect.right > PicRect.right * imag then trect.right := PicRect.right * imag; if trect.bottom > PicRect.bottom * imag then trect.bottom := PicRect.bottom * imag; wrect := trect; with SrcRect do begin ZoomCenterH := left + round((wrect.right div 2) / magnification); ZoomCenterV := top + round((wrect.bottom div 2) / magnification); width := wrect.right div imag; height := wrect.bottom div imag; left := ZoomCenterH - width div 2; if left < 0 then left := 0; if (left + width) > PicRect.right then left := PicRect.right - width; top := ZoomCenterV - height div 2; if top < 0 then top := 0; if (top + height) > PicRect.bottom then top := picRect.bottom - height; right := left + width; bottom := top + height; end; end; SizeWindow(WhichWindow, trect.right, trect.bottom, true); exit(DoGrow) end; if WhichWindow = PlotWindow then begin PlotWidth := LoWord(NewSize); PlotHeight := hiWord(NewSize); SizeWindow(PlotWindow, PlotWidth, Plotheight, true); GetPort(tPort); SetPort(PlotWindow); InvalRect(PlotWindow^.PortRect); SetPort(tPort); end; end; procedure Zoom; {(event: EventRecord)} var width, height, OldMagnification: extended; PicCenterH, PicCenterV: integer; begin if Info = NoInfo then begin beep; exit(Zoom) end; if Info^.ScaleToFitWindow then begin PutMessage('Zooming does not work in "Scale to Fit Window" mode.', '', ''); exit(Zoom) end; if BitAnd(Event.modifiers, OptionKey) = OptionKey then begin DeZoom; WhatToUndo := NothingToUndo; exit(Zoom) end; with Info^ do begin OldMagnification := magnification; if magnification = 1.0 then magnification := 2.0 else if magnification = 2.0 then magnification := 3.0 else if magnification = 3.0 then magnification := 4.0 else begin magnification := magnification * 2.0; if magnification > 64.0 then begin magnification := 64.0; exit(Zoom) end; end; end; {with} with Info^.SrcRect, Info^ do begin PicCenterH := left + round(event.where.h / OldMagnification); PicCenterV := top + round(event.where.v / OldMagnification); width := wrect.right / magnification; height := wrect.bottom / magnification; left := PicCenterH - round(width / 2); if left < 0 then left := 0; if (left + width) > PicRect.right then left := PicRect.right - round(width); top := PicCenterV - round(height / 2); if top < 0 then top := 0; if (top + height) > PicRect.bottom then top := picRect.bottom - round(height); right := left + round(width); bottom := top + round(height); RoiShowing := false; UpdatePicWindow; DrawMyGrowIcon(wptr); end; WhatToUndo := UndoZoom; ShowRoi; end; procedure Scroll; {(event: EventRecord)} var hstart, vstart, DeltaH, DeltaV, width, height: integer; loc: point; SaveSrcRect: rect; begin if info^.ScaleToFitWindow then begin PutMessage('Scrolling does not work in "Scale to Fit Window" mode.', '', ''); exit(Scroll) end; with event.where do begin hstart := h; vstart := v end; with Info^.SrcRect do begin width := right - left; height := bottom - top end; SaveSrcRect := Info^.SrcRect; while StillDown do begin GetMouse(loc); DeltaH := hstart - loc.h; DeltaV := vstart - loc.v; with Info^ do begin with SrcRect do begin left := SaveSrcRect.left + DeltaH; if left < 0 then left := 0; if (left + width) > PicRect.right then left := PicRect.right - width; right := left + width; top := SaveSrcRect.top + DeltaV; if top < 0 then top := 0; if (top + height) > PicRect.bottom then top := PicRect.bottom - height; bottom := top + height; end; UpdatePicWindow; DrawMyGrowIcon(wptr); end; end; WhatToUndo := NothingToUndo; ShowRoi; end; procedure ConvertClipboard; {Converts local scrape to system scrape. Used when quiting or} {switching to other programs or DAs . } var PicH: PicHandle; PicRect, frect: rect; tPort, sPort: GrafPtr; SaveClipRgn: RgnHandle; err: LongInt; begin PicH := nil; if (WhatsOnClip = RectPic) and (ClipBuf <> nil) and not ClipboardConverted then with ClipBufInfo^ do begin ShowWatch; sPort := GrafPtr(CScreenPort); GetPort(tPort); SetPort(sPort); with sPort^ do begin SaveClipRgn := ClipRgn; ClipRgn := NewRgn; SetRectRgn(ClipRgn, -30000, -30000, 30000, 30000); with osroiRect do SetRect(frect, 0, 0, right - left, bottom - top); LoadLUT(ctable); PicH := OpenPicture(frect); hlock(handle(osPort^.portPixMap)); hlock(handle(CGrafPort(ThePort^).PortPixMap)); CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPort(ThePort^).PortPixMap)^^, osroiRect, frect, SrcCopy, nil); hunlock(handle(osPort^.portPixMap)); hunlock(handle(CGrafPort(ThePort^).PortPixMap)); ClosePicture; DisposeRgn(clipRgn); clipRgn := SaveClipRgn; end; SetPort(tPort); end; if (PicH <> nil) or TextOnClip then begin err := ZeroScrap; if err = NoErr then begin if PicH <> nil then begin hlock(handle(PicH)); err := PutScrap(GetHandleSize(handle(PicH)), 'PICT', handle(PicH)^); hunlock(handle(PicH)); DisposHandle(handle(PicH)); end; if TextOnClip and (err = noErr) then err := PutScrap(TextBufSize, 'TEXT', ptr(TextBufP)); end; end; ClipboardConverted := true; end; procedure SetupOperation; {(item: integer)} var AutoSelectAll: boolean; begin if NotinBounds then exit(SetupOperation); if (item = 10) then if NoSelection then exit(SetupOperation); StopDigitizing; AutoSelectAll := not Info^.RoiShowing; if AutoSelectAll then SelectAll(true); SetupUndo; WhatToUndo := UndoEdit; case Item of 8: begin CurrentOp := PaintOp; OpPending := true end; 9: begin CurrentOp := InvertOp; OpPending := true end; 10: begin CurrentOp := FrameOp; OpPending := true end; end; if AutoSelectAll then KillRoi; end; end. 
